perm filename VIEWER[GEM,BGB]6 blob
sn#058577 filedate 1973-08-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00007 00002 TITLE VIEWER - IMAGE FORMING SUBROUTINES - JULY 1972.
C00011 00003 SUBR(IIIDPY,WINDOW,GLASS) Display device routine. *
C00013 00004 SUBR(YDPY,NODE)
C00016 00005 SUBR(DPYARW,NODE)
C00021 00006 ---- DPYARW continued.
C00023 00007 ARROW PARAMETERS:
C00024 00008 SUBR(SHOW1,WND,POG) DISPLAY ALL EDGES IN VIEW.
C00026 00009 SUBR(SHOW2,WND,POG) VECTOR HIDDEN LINE IMAGE.
C00028 00010 SUBR(CROP,WINDOW)
C00030 00011 SUBR(PPROJ,CAMERA,WORLD)
C00033 00012 SUBR(VPROJ,VERTEX,CAMERA) TRANSLATE VERTEX TO CAMERA LOCUS.
C00035 00013 SUBR(UNPROJECT,VERTEX,CAMERA)
C00037 00014 SUBR(FACOEF,BF,FLAG) FACE COEFFICIENTS.
C00040 00015 SUBR(ENORM,BODY) COMPUTE EDGE NORMALS FROM FACE NORMALS.
C00042 00016 SUBR(ZCLIPF,FACE,CAMERA)
C00044 00017 SUBR(FMRK,WORLD) MARK POTENT FACES.
C00047 00018 SUBR(EMRK,WORLD) MARK POTENT EDGES FOR OCCULT.
C00050 00019 SUBR(ZCLIP,VERT1,VERTU,VERT2,CAMERA)
C00052 00020 SUBR(XYCLIP)
C00054 00021 XY-CLIPPER continued.
C00056 00022 SUBR(CLIPER,WINDOW)
C00058 00023 FOR ALL THE BODIES.
C00061 00024 SUBR(EXTARW,NODE,CAMERA)
C00064 00025 ---- EXTARW continued.
C00066 00026 Arrow Extension Mandala
C00068 ENDMK
C⊗;
TITLE VIEWER - IMAGE FORMING SUBROUTINES - JULY 1972.
EXTERN DPYSTR,DPYBUF,AIVECT,AVECT,RIVECT,RVECT
EXTERN DPYBRT,DPYBIG,DPYOUT,DPYSET
EXTERN OTHER,VCW,VCCW,ECCW
EXTERN KLJUTS,KLJOTS,KLTMPS
EXTERN UNIVERSE,DPYFLG,PLTFLG
;VARIABLES GLOBAL TO VIEWER SUBROUTINES.
DECLARE{XL,XH,YL,YH}
DECLARE{FOCAL,LDZ}
DECLARE{SCALEX,SCALEY}
DECLARE{SOX,SOY,MAG}
DECLARE{CAMFRAME}
DECLARE{FOLDCNT,EDGECNT}
DECLARE{CAMERA,WINDOW,WORLD,GLASS}
DECLARE{ALLSHARP}
SUBR(GEODPY) ;GEOMED'S DISPLAY REFRESH
;--------------------------------------------------------------------
LACI 1↔DAC GLASS#
LAC 1,UNIVERSE
CW 1,1↔DAC 1,W0 ;FIRST WINDOW OF DISPLAY RING.
L1: DAC 1,W
PUSH P,1↔PUSH P,GLASS
LAC 1,DPYFLG
DZM DMODE↑↔CAIN 1,3↔DOM DMODE ;OCCULT DIAGONOSTICS.
PUSHJ P,@[SHOW2↔SHOW3↔SHOW1↔SHOW2](1)
AOS GLASS
L2: LAC 1,W↔SIS 1,1 ;NEXT WINDOW OF THE NOW DISPLAY RING.
CAME 1,W0↔GO L1
POP0J
DECLARE{W,W0}
ENDR GEODPY;7/12/73(BGB)---------------------------------------------
SUBR(IIIDPY,WINDOW,GLASS) ;Display device routine. *
COMMENT ⊗------------------------------------------------------------
⊗↔ E←←16
CALL(DPYSET,DPYBUF) ;NEW POG
;DISPLAY WINDOW FRAME.
LAC 1,WINDOW
NIP 1(1)↔DAC XL ;PICK UP 2D CLIPPER WINDOW
NAP 1(1)↔DAC XH
NIP 2(1)↔DAC YL
NAP 2(1)↔DAC YH
TESTZ 1,DARKEN↔GO L0
CALL(AIVECT,XL,YL) ;MAKE A BOARDER
CALL(AVECT,XH,YL)
CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)
CALL(AVECT,XL,YL)
;DISPLAY THE VISIBLE EDGE LIST.
L0: LAC E,WINDOW
NCAMR E,E↔PWRLD E,E ;GET THE WORLD.
JUMPE E,L3 ;NOTHING THERE, RETURN
PED E,E↔SKIPA ;FIRST EDGE OF WORLD.
L1: ALT2 E,E↔JUMPE E,L3 ;GET AN EDGE.
X1DC 1,E↔Y1DC 2,E
CALL(AIVECT,1,2)
X2DC 1,E↔Y2DC 2,E
CALL(AVECT,1,2)
PVT 1,E↔CALL(YDPY,1) ;CHECK EACH VERTEX FOR YNODES
L2: NVT 1,E↔CALL(YDPY,1)
GO L1
L3: CALL(DPYOUT,GLASS)
POP2J
BEND IIIDPY; BGB 5 FEB 1973 --------------------------------------
DECLARE{TX,TY}
SUBR(YDPY,NODE)
COMMENT ⊗------------------------------------------------------------
⊗↔ T←15 ↔ SIZ←14
LAC 1,NODE↔TESTZ 1,NSEW+TBIT1 ;IF INVISIBLE, THEN SKIP THIS ONE
POP1J↔PY T,1 ;GET TJOINT OR TEXT OF VERTEX
JUMPE T,POP1J.↔DAC T,NODE ;NOTHING THERE
LAC 0,(T)↔ANDI 0,17
CAIE 0,$YNODE↔POP1J ;IF IT'S A TJOINT, LEAVE
MARK 1,TBIT1 ;REMEMBER WE'VE BEEN HERE
GO YDPY1
YDPY2: LAC T,NODE↔PY T,T↔JUMPE T,POP1J.
YDPY1: DAC T,NODE↔YCODE 1,T
CAIN 1,$TEXTHD↔GO DPYTXT
CAIN 1,$ARROW↔GO[CALL DPYARW,T↔GO YDPY2]
FATAL(ILLEGAL YNODE FOUND)
DPYTXT: ;FETCH COORDINATES.
DPSIZ SIZ,T
XDC 0,T↔FIXX 0,↔CAR 0,CHROFF(SIZ)↔SKIPN PLTFLG↔ADD 0,1↔DAC 0,TX
YDC 0,T↔FIXX 0,↔CDR 0,CHROFF(SIZ)↔SKIPN PLTFLG↔ADD 0,1↔DAC 0,TY
PTEXT T,T↔SKIPN SIZ↔LACI SIZ,1
CALL(DPYBRT,[1])↔CALL(DPYBIG,SIZ)↔LAC 0,TY
DPYTX2: CAMGE 0,YH↔CAMGE 0,YL↔GO DPYTX3 ;MAKE SURE IT'S WITHIN WINDOW
CALL(AIVECT,TX,TY) ;POSITION IT
DPYTX4: MOVEI 0,1(T)
CALL(DPYSTR,0) ;DISPLAY IT (THIS MAY OVERFLOW WEST)
TESTZ T,CONBIT ;IS IT CONTINUED?
GO [ TCCW T,T ;YES, GET NEXT LINE
JUMPN T,DPYTX4 ;MAKE SURE THERE'S SOMETHING THERE
FATAL<Missing continuation of text node.> ]
DPYTX3: TCCW T,T↔JUMPE T,YDPY2 ;GET NEXT TEXT NODE (OR E.O.L).
; HRREI 0,-20 ;THIS REALLY SHOULD BE SIZE DEPENDENT
HRRZ 0,CHRSIZ(SIZ)
MOVN↔ADDB 0,TY ;INCREMENT
GO DPYTX2
ENDR YDPY;-----------------------------------------------------------
CHRSIZ: 20 ;0 (SAME AS 2)
20 ;1
30 ;2
34 ;3
40 ;4
60 ;5
100 ;6
140 ;7
CHROFF: XWD =-9,=-9 ;0 (SAME AS 2)
XWD =-8,=-7 ;1
XWD =-9,=-9 ;2
XWD =-9,=-11 ;3
XWD =-8,=-13 ;4
XWD =-9,=-16 ;5
XWD =-10,=-21 ;6
XWD =-11,=-25 ;7
SUBR(DPYARW,NODE)
;Display an arrow
ACCUMULATORS{FLG,T1,N,V1,V2,DX1,DY1,DX2,DY2,X1,Y1}
ARWSIZ←←1
;Decide whether to make arrow this time
LAC N,NODE ;FETCH NODE IN QUESTION
TESTZ N,NSEW↔POP1J ;MAKE SURE IT'S NOT OFF SCREEN
TEST N,TBIT1↔POP1J ;HAVEN'T WE BEEN HERE BEFORE...
PARRW V2,N ;AND THE OTHER END
MARKZ N,TBIT1 ;SO WE WOULD COME THRU TWICE WITH SAME VERTEX
TESTZ V2,TBIT1 ;HAVE WE BEEN HERE YET?
POP1J ;NO, RETURN AND TRY AGAIN
;Check for off screen
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V2,V2 ;NOW GET SECOND VERTEX
TESTZ V2,NSEW↔POP1J ;CHECK FOR OFF SCREEN
PVT V1,N ;AND LASTLY THE FIRST VERTEX
TESTZ V1,NSEW↔POP1J ;CHECK FOR OFF SCREEN
LAC 0,XWC(V2) ;Calculate distance between points
FSBR 0,XWC(V1)
FMPR 0,0
LAC 1,YWC(V2)
FSBR 1,YWC(V1)
FMPR 1,1
FADR 0,1
LAC 1,ZWC(V2)
FSBR 1,ZWC(V1)
FMPR 1,1
FADR 0,1
CALL SQRT,0
MOVE X1,[POINT 7,ARWBLK] ;Convert to character stream
SETZ Y1,
CALL(WRFLO↑,0,<[JSP DY2,[IDPB 1,X1↔AOJA Y1,(DY2)]]>)
DAC Y1,CHRCNT
SETZ 1,
IDPB 1,X1
;Calculate extention, etc.
XDC DX1,V2 ;Fetch coordinates of V2
YDC DY1,V2
XDC DX2,N ;Fetch coordinates of V1'
YDC DY2,N
XDC 0,V1 ;Fetch coordinates of V1
YDC 1,V1 ; -→
FSBR DX1,0 ;Calculate E1
FSBR DY1,1 ; -→
FSBR DX2,0 ;Calculate E2
FSBR DY2,1 ; -→
FSC DX1,-1 ;Divide E1 by 2.0
FSC DY1,-1
FADR 0,DX1 ;This is the bisector of V1' and V2'
FADR 1,DY1
FADR 0,DX2
FADR 1,DY2
DAC 0,XCEN ;Save somewhere
DAC 1,YCEN
LAC 0,DX1 ;Normalize
LAC 1,DY1
CALL DIST
FDVR DX1,1
FDVR DY1,1
LAC 0,DX2 ;Normalize
LAC 1,DY2
CALL DIST
FDVR DX2,1
FDVR DY2,1
MOVN 0,DX2
MOVN 1,DY2
FMPR 0,K4
FMPR 1,K4
FADRM 0,XCEN
FADRM 1,YCEN
CALL(DPYBIG,[ARWSIZ])
MOVN X1,CHRCNT ;Calculate center of arrow
IMUL X1,CHRSIZ+ARWSIZ
FSC X1,231 ;(Float and divide by 4)
DACM X1,XOFFSET
FADR X1,XCEN
MOVN Y1,CHRSIZ+ARWSIZ
FSC Y1,232 ;(Float and divide by 2)
FADR Y1,YCEN
CAR 0,CHROFF+ARWSIZ ;Correct for losing III!
FSC 0,233
SKIPN PLTFLG
FADR X1,0
CDR 0,CHROFF+ARWSIZ
FSC 0,233
SKIPN PLTFLG
FADR Y1,0
CALL FAI
CALL(DPYSTR,[ARWBLK])
LAC 0,DX1
LAC 1,DY1
CALL DIST
LAC 1,CHRSIZ+ARWSIZ
FSC 1,232 ;(Float and divide by 2)
FDVRB 1,0
FMPR 0,DX1
FDVR 0,DY1
LACM 0,0
CAMGE 0,1
LAC 0,1
CAMLE 0,XOFFSET
LAC 0,XOFFSET
LAC 1,CHRSIZ+ARWSIZ
FSC 1,232 ;(Float and divide by 2)
FADR 0,1
DAC 0,K3
CALL HALF ;Do first half of arrow
MOVN DX1,DX1 ; -→
MOVN DY1,DY1 ;XChange sign of E1
EXCH V1,V2 ;Switch vertices
PARRW N,N ;And Ynodes
XDC DX2,N ;Fetch coordinates of V1'
YDC DY2,N
XDC 0,V1 ;Fetch coordinates of V1
YDC 1,V1 ; -→
FSBR DX2,0 ;Calculate E2
FSBR DY2,1 ; -→
LAC 0,DX2 ;Normalize
LAC 1,DY2
CALL DIST
FDVR DX2,1
FDVR DY2,1
CALL HALF
POP1J
;---- DPYARW continued.
DIST: FMPR 0,0 ;Calculate length of vector
FMPR 1,1
FADR 1,0
CALL SQRT↑,1
POP0J
HALF: LAC X1,V1 ;Draw extension
LACI Y1,DX2
LAC 0,K5
CALL OFFAI
LAC X1,N
SETZ 0,
CALL OFFAV
LAC X1,N ;Upper wing of arrow
LACI Y1,DX2
MOVN 0,K4
CALL OFFAI
PUSHP X1 ;Save start of arrow
PUSHP Y1
LAC 0,DX1
LAC 1,DY1
FMPR 0,K1
FMPR 1,K1
LAC X1,DX2
LAC Y1,DY2
FMPR X1,K2
FMPR Y1,K2
FADR 0,X1
FADR 1,Y1
FIX 0,233000
FIX 1,233000
CALL RVECT,0,1
MOVN 0,X1 ;Now the lower wing
MOVN 1,Y1
FIX 0,232000 ;(Doubles)
FIX 1,232000
CALL RIVECT,0,1
CALL AVECT ;(With arguments saved above)
MOVN X1,DX1 ;The main line of arrow
MOVN Y1,DY1
FMPR X1,K3
FMPR Y1,K3
FADR X1,XCEN
FADR Y1,YCEN
FAV: SETO FLG
GO FVECT
FAI: SETZ FLG,
GO FVECT
OFFAI: TDZA FLG,FLG
OFFAV: SETO FLG,
LAC 1,0
JUMPE 0,.+3
FMPR 0,(Y1)
FMPR 1,1(Y1)
YDC Y1,X1
XDC X1,X1
FADR X1,0
FADR Y1,1
FVECT: FIX X1,233000
FIX Y1,233000
JUMPE FLG,[CALL AIVECT,X1,Y1
POP0J]
CALL AVECT↑,X1,Y1
POP0J
DECLARE{XCEN,YCEN,CHRCNT,XOFFSET}
ARWBLK: BLOCK 10
;ARROW PARAMETERS:
COMMENT $
----- ⊗
↑ | |
| -→| K1 |←-
| | |____
K4 | / ↑
| | / | | |
| | / K2 |←- K3 -→|
↓ | / | | |
----- |/______↓________________________ .
-→|\ (Center of dimension)
E2| \
| \
| | \
↓ |
--- | -→
K5 E1
--- ⊗____________________________________________________________
↑
|
-→ -→
E1 = (DX1,DY1) E2 = (DX2,DY2)
$;
K1: 20.0
K2: 7.0
;K3: 20.0
DECLARE{K3} ;Set according to size of text
K4: 10.0
K5: 4.0
ENDR DPYARW
SUBR(SHOW1,WND,POG) ;DISPLAY ALL EDGES IN VIEW.
COMMENT ⊗---------------------------------------------------------
⊗
SETOM ALLSHARP
LAC 1,WND↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ,CAMERA,WORLD)
CALL(EMRKALL,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
POP2J
ENDR SHOW1;3/16/73(BGB)-------------------------------------------
SUBR(SHOW3,WND,POG) ;DISPLAY BACKSIDED FACES REMOVED.
COMMENT ⊗-------------------------------------------------------
⊗↔ SETZM ALLSHARP
LAC 1,WND↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
POP2J
ENDR SHOW3;3/16/73(BGB)-------------------------------------------
SUBR(SHOW2,WND,POG) ;VECTOR HIDDEN LINE IMAGE.
COMMENT ⊗------------------------------------------------------------
⊗
SETZM ALLSHARP
LAC 1,WND↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT↑,WORLD)
CALL(KLJOTS,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
SKIPGE POG↔POP2J
CALL(KLTMPS,WORLD)
POP2J
ENDR SHOW2;3/16/73(BGB)----------------------------------------------
SUBR(TAKE,CAMR) ;SIMULATED TAKE A PICTURE.
COMMENT ⊗------------------------------------------------------------
⊗ DZM ALLSHARP
LAC 1,CAMR↔DAC 1,CAMERA↔JUMPE 1,POP1J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT↑,WORLD)
CALL(MKSIMG↑,CAMERA) ;MAKE A SIMULATED IMAGE.
CALL(KLTMPS,WORLD)
POP1J
ENDR TAKE;7/14/73(BGB)-----------------------------------------------
SUBR(CROP,WINDOW)
COMMENT ⊗------------------------------------------------------------
Crop object window to III destination window.
; XL ← (OX - MAG*LDX) MAX -511.
; XH ← (OX + MAG*LDX) MIN +511.
; YL ← (OY - MAG*LDY) MAX -384.
; YH ← (OY + MAG*LDY) MIN +384.
⊗↔ ACCUMULATORS{WND,C,OX,OY,LDX,LDY,MAG}
LAC WND,WINDOW
NCAMR C,WND↔JUMPE C,POP1J.
LAC MAG,-1(WND)
NIP OX,-2(WND)↔FLOAT OX,
NAP OY,-2(WND)↔FLOAT OY,
NAP LDX,1(C)↔FLOAT LDX,
NAP LDY,2(C)↔FLOAT LDY,
LAC LDX↔FMPR MAG↔DAC OX,1
FSBR 1,0↔FADR 0,OX↔FIXX 0,↔FIXX 1,
CAMGE 1,[-=511]↔LAC 1,[-=511]↔DIP 1,1(WND)
CAMLE 0,[ =511]↔LAC 0,[ =511]↔DAP 0,1(WND)
LAC LDY↔FMPR MAG↔DAC OY,1
FSBR 1,0↔FADR 0,OY↔FIXX 0,↔FIXX 1,
CAMGE 1,[-=384]↔LAC 1,[-=384]↔DIP 1,2(WND)
CAMLE 0,[ =384]↔LAC 0,[ =384]↔DAP 0,2(WND)
POP1J
ENDR CROP;3/13/73(BGB)--------------------------------------------
SUBR(PPROJ,CAMERA,WORLD)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ}
LAC B,WORLD↔$TYPE 0,B↔CAIE 0,$WORLD↔POP2J
;CLEAR FACE PZZ & NZZ BITS.
LAC B,WORLD
I0: CCW B,B↔CAME B,WORLD↔GO[LAC F,B
I1: PFACE F,F↔CAMN F,B↔GO I0↔MARKZ F,PZZ+NZZ↔GO I1]
;GET CAMERA SCALES AND FOCAL.
LAC CAM,CAMERA
LAC -3(CAM)↔DAC SCALEX
LAC -2(CAM)↔DAC SCALEY
HLLZ 3(CAM)↔DAC FOCAL
CDR 3(CAM)↔FLOAT↔DAC LDZ
;GET THE CAMERA'S FRAME.
LAC CAM,CAMERA
FRAME CAM,CAM
DAC CAM,CAMFRAME
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP2J
MARKZ B,VISIBLE
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: PVT V,V↔CAMN V,B↔GO L1
CALL(VPROJ,V,CAMERA)
;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
LAC X,[JUTBIT+JOTBIT+PZZ+NZZ+FOLDED+VISIBLE+POTENT+TBIT1+TBIT2+TBIT3]
ANDCAM X,(V) ;TURN 'EM ALL OFF.
SLACI X,(PZZ) ; + HALFSPACE, BEHIND THE CAMERA.
MOVN FOCAL
CAMGE ZZ,0 ;SKIP WHEN Zcc ≥ -FOCAL.
SLACI X,(NZZ) ; - HALFSPACE, INVIEW.
IORM X,(V)
PED E,V↔DAC E,E0↔JUMPE E,[
PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.
L3: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L4 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
L4: IORM X,(E)
PFACE F,E↔IORM X,(F)
NFACE F,E↔IORM X,(F)
LAC E,1↔CAME E,E0↔GO L3↔GO L2
ENDR PPROJ;1/14/73(BGB)----------------------------------------------
SUBR(VPROJ,VERTEX,CAMERA) ;TRANSLATE VERTEX TO CAMERA LOCUS.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ,FRM}
LAC CAM,CAMERA
FRAME FRM,CAM
LAC V,VERTEX
LAC X,XWC(V)↔FSBR X,XWC(FRM)
LAC Y,YWC(V)↔FSBR Y,YWC(FRM)
LAC Z,ZWC(V)↔FSBR Z,ZWC(FRM)
APROJ2:
;ROTATE TO CAMERA ORIENTATION.
DEFINE ROTATE $(QQ,Q){
LAC QQ,X↔ FMPR QQ,Q$X(FRM)
LAC Y↔FMPR Q$Y(FRM)↔FADR QQ,
LAC Z↔FMPR Q$Z(FRM)↔FADR QQ,}
ROTATE(XX,I);
ROTATE(YY,J);
ROTATE(ZZ,K);
;PERSPECTIVE TRANSFORMATION.
TESTZ CAM,NOTPER↔MOVSI ZZ,(<-16.0>)
FMPR XX,-3(CAM)↔FDVR XX,ZZ↔DAC XX,XPP(V)
FMPR YY,-2(CAM)↔FDVR YY,ZZ↔DAC YY,YPP(V)
MOVN Z, 3(CAM)↔FSC Z,=17
FDVR Z,ZZ↔DAC Z,ZPP(V)
POP2J
;SPECIAL CALL FOR EXTARW
↑APROJ: LAC CAM,CAMERA
LAC FRM,CAMFRAME
LAC V,VERTEX
LAC X,XPP(V)↔FSBR X,XWC(FRM)
LAC Y,YPP(V)↔FSBR Y,YWC(FRM)
LAC Z,ZPP(V)↔FSBR Z,ZWC(FRM)
GO APROJ2
ENDR VPROJ;(BGB)-----------------------------------------------------
SUBR(UNPROJECT,VERTEX,CAMERA)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V,C,R,X,Y,Z,XX,YY,ZZ}
LAC V,VERTEX
LAC C,CAMERA
FRAME R,C
;UNDO PERSPECTIVE.
LACN Z,3(C)↔FSC Z,=17↔FDVR Z,ZPP(V) ;SCALEZ.
LAC Y,YPP(V)↔FMPR Y,Z↔FDVR Y,-2(C) ;SCALEY.
LAC X,XPP(V)↔FMPR X,Z↔FDVR X,-1(C) ;SCALEX.
;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
LAC XX,X↔FMPR XX,IX(R)
LAC Y↔FMPR JX(R)↔FADR XX,
LAC Z↔FMPR KX(R)↔FADR XX,
LAC YY,Y↔FMPR YY,IY(R)
LAC Y↔FMPR JY(R)↔FADR YY,
LAC Z↔FMPR KY(R)↔FADR YY,
LAC ZZ,Z↔FMPR ZZ,IZ(R)
LAC Y↔FMPR JZ(R)↔FADR ZZ,
LAC Z↔FMPR KZ(R)↔FADR ZZ,
;TRANSLATE TO CAMERA LOCUS.
FADR XX,XWC(R)↔DAC XX,XWC(V)
FADR YY,YWC(R)↔DAC YY,YWC(V)
FADR ZZ,ZWC(R)↔DAC ZZ,ZWC(V)
POP2J
ENDR UNPROJECT;1/14/73(BGB)------------------------------------------
SUBR(FACOEF,BF,FLAG) ;FACE COEFFICIENTS.
COMMENT ⊗------------------------------------------------------------
FLAG=0 FOR WC, FLAG=-1 FOR PP.
⊗↔ ACCUMULATORS {Q2,Q3,E,V1,V2,V3,ABC,F,ARG,E0}
FOR @% Qε{XYZ}{FOR @$ N←1,3{ ;DEFINE X1,Y1,Z1, etc.
DEFINE Q%$N<Q%WC(V$N)>↔}}
;FOR ALL THE FACES OF EACH BODY.
LAC F,BF↔LAC ARG,(F) ;ORIGINAL ARG TYPE.
TLNN ARG,(BBIT)↔GO L2
L1: PFACE F,F
TEST F,FBIT↔POP2J
;FIRST THREE VERTICES CCW ABOUT THE FACE.
L2: PED E,F↔DAC E,E0↔ZIP 6(F);CLEAR FACE'S ALT LINK (FOR EHIDE TMP).
L3: SETQ(V1,{VCW,E,F})
SETQ(V2,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
SETQ(V3,{VCCW,E,F})
;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
SKIPE FLAG↔GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1↔LAC 2,X2↔FMPR 2,Z3
LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2↔LAC 3,Y2↔FMPR 3,X3
LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3↔DAC 1,KK(F)
MOVMS 1↔CAML 1,[1.0]↔GO L4 ;SKIP KK TOO SMALL.
CAME E,E0↔GO L3
;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
L4: LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1↔ DAC AA(F)↔FMPR↔DAC ABC
;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1↔ DAC BB(F)↔FMPR↔FADRM ABC
;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1↔ DAC CC(F)↔FMPR↔FADRM ABC
;NORMALIZE.
CALL(SQRT↑,ABC)↔SLACI(<1.0>)↔FDVR 1
FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
TLNN ARG,(BBIT)↔POP2J↔GO L1
ENDR FACOEF;1/14/73(BGB)---------------------------------------------
SUBR(ENORM,BODY) ;COMPUTE EDGE NORMALS FROM FACE NORMALS.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{E,F1,F2}
LAC E,BODY
PED E,E↔CAMN E,BODY↔POP1J
PFACE F1,E↔NFACE F2,E
LAC AA(F1)↔FAD AA(F2)↔FSC -1↔DACN AA(E)
LAC BB(F1)↔FAD BB(F2)↔FSC -1↔DACN BB(E)
LAC CC(F1)↔FAD CC(F2)↔FSC -1↔DACN CC(E)
GO ENORM+1
ENDR ENORM;1/14/73(BGB)----------------------------------------------
SUBR(VNORM,BODY) ;COMPUTE VERTEX NORMALS FROM EDGE NORMALS.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V,E,E0,A,B,C}
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
PED E,V↔SKIPN E0,E↔POP1J ;VERTEX BODY CASE.
SETZB 0,A↔SETZB B,C
L2: FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
CAME E,E0↔AOJA L2↔AOS
FLOAT↔FDV A,↔FDV B,↔FDV C,
DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
GO L1
ENDR VNORM;1/14/73(BGB)----------------------------------------------
SUBR(ZCLIPF,FACE,CAMERA)
COMMENT ⊗------------------------------------------------------------
⊗↔ GO L0
DECLARE{F,E,V,V1,V2,U0,U1,U2,ENEW,F0}
EXTERN MKFE,ESPLIT
;GET A PZZ VERTEX OF F0 - PZZ ≡ BEHIND THE CAMERA.
L0: LAC 1,FACE
DAC 1,F0↔DAC 1,U1↔DAC 1,F
PED 0,1↔DAC E
L1: SETQ(E,{ECCW,E,F})
SETQ(V,{VCCW,E,F})
TEST 1,PZZ↔GO L1
;GET FIRST NZZ VERTEX CCW AROUND F FROM E - NZZ ≡ INVIEW.
L2: SETQ(E,{ECCW,E,F})
SETQ(V,{VCCW,E,F})
TEST 1,NZZ↔GO L2
;MAKE Z-CLIP VERTEX.
LAC 1,E↔PVT 0,1↔CAMN 0,V↔GO .+3↔CALL(INVERT,E)
PVT 0,1↔DAC V1
NVT 0,1↔DAC V2
SETQ(U2,{ESPLIT,E})
LAC 1,U2↔MARK 1,TMPBIT
CALL(ZCLIP,V1,U2,V2,CAMERA)
CALL(UNPROJECT,U2,CAMERA)
LAC 1,U2↔MARK 1,NZZ
;MAKE Z-CLIP EDGE.
L3: LAC 1,U1↔TEST 1,VBIT↔GO L4 ;U1 IS FACE ON 1ST TIME THRU.
SETQ(ENEW,{MKFE,U1,F,U2})
LAC 2,ENEW↔MARK 2,TMPBIT ;NEW EDGE IS TEMPORARY.
NFACE 1,2↔MARK 1,PZZ ;NEW FACE IS BEHIND THE CAMERA.
EXCH 1,F↔MARKZ 1,PZZ↔MARK 1,NZZ ;OLD FACE IS INVIEW.
CAMN 1,F0↔POP2J↔GO .+3 ; ...EXIT OR PASS OVER.
L4: LAC U2↔DAC U0
;ADVANCE INTO THE NEXT FACE.
LAC U2↔DAC U1
SETQ(F,{OTHER,E,F})
CAME 1,F0↔GO L2
LAC U0↔DAC U2↔GO L3
ENDR ZCLIPF;1/14/73(BGB)---------------------------------------------
SUBR(FMRK,WORLD) ;MARK POTENT FACES.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{W,B,F,Q,R}
;INITIALIZE THE WORLD'S POTENTIALLY VISIBLE FACE AND EDGE LISTS.
LAC 1,WORLD↔ZAC
PFACE. 0,1↔PED. 0,1↔NED. 0,1
NCAMR 1,1↔DAC 1,CAMERA#
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD↔DAC B,BODY#
L1: LAC B,BODY↔CCW B,B↔DAC B,BODY
CAMN B,WORLD↔POP1J
PED 1,B↔TEST 1,EBIT↔POP1J ;DON'T LOOK AT SINGLE POINTS
;FOR ALL THE FACES OF EACH BODY.
LAC F,B
L2: PFACE F,F↔DAC F,FACE#
CAMN F,BODY↔GO L1
MARKZ F,VISIBLE+POTENT ;HIDE.
TEST F,NZZ↔GO L2 ;FACE IS FULLY BEHIND THE CAMERA.
TEST F,PZZ↔GO L3 ;FACE IS PARTIALLY IN VIEW.
CALL(ZCLIPF,F,CAMERA) ;DO Z-CLIPPING.
LAC F,FACE
L3: CALL(FACOEF,F,[-1]) ;FLG=-1 FOR PP COORDINATES.
LAC F,FACE
LAC CC(F)↔FMPR LDZ
CAML KK(F)↔GO L2 ;FACE HAS BACKSIDE TOWARDS CAMERA.
;POTENTIALLY VISIBLE FACE.
L4: MARK F,POTENT
MARKZ F,TBIT1
LAC 1,WORLD↔PFACE 0,1
POTEN. 0,F↔PFACE. F,1
GO L2
ENDR FMRK;1/14/73(BGB)-----------------------------------------------
SUBR(EMRKALL,WORLD) ;MARK ALL EDGE AS POTENT.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,E}
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE EDGES OF EACH BODY.
LAC E,B
L2: PED E,E↔CAMN E,B↔GO L1
MARK E,POTENT↔GO L2
ENDR EMRKALL;1/14/73(BGB)--------------------------------------------
SUBR(EMRK,WORLD) ;MARK POTENT EDGES FOR OCCULT.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{Q,R,S,B,F1,F2,E,A}
ACCUMULATORS{V1,V2}
DZM FOLDCNT↔DZM EDGECNT
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE EDGES OF EACH BODY.
LAC E,B
L2: PED E,E↔CAMN E,B↔GO L1
DZM↔POTEN. 0,(E)
MARKZ E,FOLDED+VISIBLE+POTENT
PFACE F1,E
NFACE F2,E
;WHEN EITHER FACE IS POTENT THEN THE EDGE IS POTENT.
LAC(F1)↔IOR(F2)↔TLNN(POTENT)↔GO L2
MARK E,POTENT
;CONS THE EDGE INTO THE WORLD'S POTENTIALLY VISIBLE EDGE LIST.
LAC 1,WORLD↔PED 0,1↔SKIPN↔NED. E,1
PED. E,1↔POTEN. 0,E↔ZAC↔UFACE. 0,E ;CLEAR UFACE(E).
AOS EDGECNT↔CALL(ECOEF,E)
MARK V1,POTENT↔IORM(V2)
;WHEN ONLY ONE FACE IS POTENT THEN EDGE IS FOLDED.
LAC(F1)↔XOR(F2)↔TLNN(POTENT)↔GO L2
TEST F1,POTENT↔GO[CALL(INVERT↑,E)↔GO .+1];NOTA BENE !
MARK E,FOLDED↔IORM(V1)↔IORM(V2)
WAC↔UFACE. 0,E ;EMPTY UNDER FACE OF FOLDS.
GO L2
ENDR EMRK;1/14/73(BGB)-----------------------------------------------
;COMPUTE NORMALIZED EDGE COEFFICIENTS.
SUBR(ECOEF,EDGE)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{V1,V2,S,B,F1,F2,E,A,FLG} ;BUT ONLY V1,V2,E,S.
LAC E,EDGE↔NVT V1,E↔PVT V2,E
LAC YPP(V2)↔FSBR YPP(V1)↔DAC AA(E)↔FMPR↔DAC 1
LAC XPP(V1)↔FSBR XPP(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
LAC XPP(V2)↔FMPR YPP(V1)
LAC S,XPP(V1)↔FMPR S,YPP(V2)↔FSBR S↔DAC CC(E)
CALL(SQRT↑,1)↔SLACI(<1.0>)↔FDVR 0,1
FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
POP1J
ENDR ECOEF;7/23/73(BGB)----------------------------------------------
SUBR(ZCLIP,VERT1,VERTU,VERT2,CAMERA)
COMMENT ⊗------------------------------------------------------------
⊗↔ F←0 ↔ U←1
ACCUMULATORS{V1,V2,X1,Y1,Z1,X2,Y2,Z2,C}
SAVAC(11)
LAC C,CAMERA
;V1 BEHIND CAMERA PLANE, V2 VEFORE CAMERA PLANE.
CDR V1,VERT1
CDR U,VERTU
CDR V2,VERT2
LAC F,3(C) ;FOCAL.
;UNPROJECT TO CAMERA CENTERED COORDINATES.
FOR @$ I←1,2{
MOVN Z$I,3(C)↔FSC Z$I,=17↔FDVR Z$I,ZPP(V$I)
LAC Y$I,Z$I↔ FMPR Y$I,YPP(V$I)↔ FDVR Y$I,-2(C)
LAC X$I,Z$I↔ FMPR X$I,XPP(V$I)↔ FDVR X$I,-3(C)}
;PIERCE Z=-FOCAL PLANE BY SIMILAR TRIANGLES & REPROJECT.
FSBR X1,X2↔ FSBR Y1,Y2↔ FSBR Z1,Z2
FADR Z2,F↔MOVNS Z2
FMPR X1,Z2↔FDVR X1,Z1↔FADR X1,X2
FMPR X1,-3(C)↔FDVR X1,F↔DACN X1,XPP(U)
FMPR Y1,Z2↔FDVR Y1,Z1↔FADR Y1,Y2
FMPR Y1,-2(C)↔FDVR Y1,F↔DACN Y1,YPP(U)
LAC 2,3(C)↔FSC 2,=17↔FDVR 2,F↔DAC 2,ZPP(U)
;MARK U'S NSEW BITS.
ACCUMULATORS{XX,YY}
LAC XX,XPP(U)↔FMPR XX,MAG↔FADR XX,SOX↔XDC. XX,U↔HLLES
LAC YY,YPP(U)↔FMPR YY,MAG↔FADR YY,SOY↔YDC. YY,U↔HLLES
TYPE 0,U↔TRZ(NSEW);NSEW RESET.
CAMLE YY,YH↔TRO(NORTH)
CAMGE YY,YL↔TRO(SOUTH)
CAMLE XX,XH↔TRO(EAST)
CAMGE XX,XL↔TRO(WEST)
TRZ(PZZ)↔TRO(NZZ)
TYPE. 0,U
GETAC(11)↔POP4J
ENDR;1/14/73(BGB)------------------------------------------------------
SUBR(XYCLIP)
COMMENT ⊗------------------------------------------------------------
XY-CLIPPER, skips when portion is visible;
expect arguments in accumulators V1 & V2;
returns results via accumulator PTR.
⊗
ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR}
;GET NSEW BITS.
LDB 0,[POINT 4,(V1),8];
LDB 1,[POINT 4,(V2),8];
TRNE 0,(1)↔POP0J ;EASY OUTSIDER.
XDC X1,V1↔YDC Y1,V1 ;GET ENDS' LOCII.
XDC X2,V2↔YDC Y2,V2
;EASY INSIDER VERTICES.
JUMPE 0,[LAC X1↔FIXX↔DIP(PTR)
LAC Y1↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1]
JUMPE 1,[LAC X2↔FIXX↔DIP(PTR)
LAC Y2↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1↔GO L]
;COMPUTE EDGE COEFFICIENTS.
LAC Y1↔FSBR Y2↔DAC A
LAC X2↔FSBR X1↔DAC B
LAC X2↔FMPR Y1↔MOVNM C
LAC X1↔FMPR Y2↔FADRM C
;PARTIAL PRODUCTS.
LAC A↔FMPR XH↔DAC AXH
LAC A↔FMPR XL↔DAC AXL
LAC B↔FMPR YH↔DAC BYH
LAC B↔FMPR YL↔DAC BYL
;CORNER Q'S.
SETOM FLGO↔SETZM FLGZ
LAC AXH↔FADR BYH↔FADR C↔DAC QNE↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYH↔FADR C↔DAC QNW↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYL↔FADR C↔DAC QSW↔ANDM FLGO↔IORM FLGZ
LAC AXH↔FADR BYL↔FADR C↔DAC QSE↔ANDM FLGO↔IORM FLGZ
;HARD OUTSIDER CASES.
SKIPGE FLGO↔POP0J
SKIPL FLGZ↔POP0J
;XY-CLIPPER continued.
;NORTH BORDER CROSSING.
LAC QNE↔XOR QNW↔SKIPL↔GO L2
LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
LAC BYH↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
LAC YH↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;SOUTH BORDER CROSSING.
L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
LAC BYL↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
LAC YL↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;EAST BORDER CROSSING.
L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
LAC XH↔FIXX↔DIP(PTR)
LAC AXH↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;WEST BORDER CROSSING.
L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
LAC XL↔FIXX↔DIP(PTR)
LAC AXL↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;STRANGE EXIT - VMARK & ECOEF ARE INCONSISTENT.
L5: OUTSTR[ASCIZ/XY-CLIPPER FALL THRU !
/]↔ POP0J
;VISIBLE PORTION EXIT.
L: AOS(P)↔POP0J
DECLARE{A,B,C,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
ENDR XYCLIP;1/14/73(BGB)---------------------------------------------
SUBR(CLIPER,WINDOW)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR,S12,B}
X←←X1 ↔ Y←←Y1 ↔ V←←V1
;SET VISIBLE EDGE LIST TO NIL AND RESET EDGE COUNT.
SETZM CNT
SETZM LINK
;GET THE 2D CLIP WINDOW FRAME.
LAC 1,WINDOW↔NCAMR 0,1↔DAC CAMERA#
NIP 1(1)↔FLOAT↔DAC XL
NAP 1(1)↔FLOAT↔DAC XH
NIP 2(1)↔FLOAT↔DAC YL
NAP 2(1)↔FLOAT↔DAC YH
;WINDOW SOURCE-OBJECT MAPPING.
LAC -1(1)↔DAC MAG
NIP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
NIP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOX
NAP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
NAP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOY
;FOR ALL THE BODIES OF THE WINDOW'S CAMERA'S SYNTHETIC & PERCEIVED IMAGES.
LAC B,WINDOW
NCAMR B,B↔PIMAG B,B↔SKIPE B↔CALL(L1) ;PERCIEVED IMAGE BODIES.
LAC B,WINDOW
NCAMR B,B↔SIMAG B,B↔SKIPE B↔CALL(L1) ;SYNTHETIC IMAGE BODIES.
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WINDOW
NCAMR B,B↔PWRLD B,B
CALL(L1)
LAC 1,LINK↔PED. 1,B ;WORLD.
POP1J
;FOR ALL THE BODIES.
L1: CCW B,B↔TEST B,BBIT↔POP0J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L1A: PVT V,V↔CAMN V,B↔GO L2-1
TESTZ V,POTENT↔ZAP 7(V) ;(OCCULT EXPEDIENCY).
CALL(VMARK2)
PY 1,V↔JUMPE 1,L1A
PUSH P,V↔PUSH P,B
YLOOP: YCODE 0,1
CAIN $TEXTHD↔GO[MARKZ 1,TBIT1↔CALL(VPROJ,1,CAMERA)↔LAC V,1(P)
CALL(VMARK2)↔LAC 1,V↔GO YCONT]
CAIN 0,$ARROW↔GO[CALL(EXTARW,1,CAMERA)↔LAC 1,1(P)↔GO YCONT]
YCONT: PY 1,1↔JUMPN 1,YLOOP
POP P,B↔POP P,V↔GO L1A
;FOR ALL THE EDGES OF EACH BODY.
LAC E,B
L2: PED E,E
CAMN E,B↔GO L1
TEST E,FOLDED↔SKIPE ALLSHARP↔GO L2A
TESTZ E,NSHARP↔GO L2
L2A: TESTZ E,DARKEN↔GO L2
TEST E,VISIBLE∨POTENT↔GO L2
;DOES EDGE NEED Z-CLIPPING.
PVT V1,E↔NVT V2,E↔LACI PTR,U
;PZZ ≡ BEHIND THE CAMERA.
TESTZ V2,PZZ↔EXCH V1,V2 ;INSURE V2 IS INVIEW, IF EITHER BE.
TESTZ V2,PZZ↔GO L2 ;EDGE IS FULLY BEHIND THE CAMERA.
TEST V1,PZZ↔GO L3 ;EDGE IS FULLY BEFORE THE CAMERA.
;CALL SUB-CLIPPER-ROUTINES.
SETQ(V1,{ZCLIP,V1,PTR,V2,CAMERA})
L3: SLACI PTR,-2↔LAPI PTR,-3(E) ;AOBJN PTR.
CALL(XYCLIP)↔GO L2 ;EDGE NOT VISIBLE IN WINDOW.
;CONS EDGE INTO VISIBLE EDGE LIST.
AOS CNT
MARK E,VISIBLE ;EDGE IS VISIBLE IN WINDOW.
LAC 1,LINK↔ALT2. 1,E
DAC E,LINK↔GO L2
;PSEUDO VERTEX FOR Z-CLIPPER.
0↔0↔0↔U: BLOCK 9↔CNT:0↔LINK:0
;COMPUTE DISPLAY COORDINATES OF A VERTEX.
VMARK2: LAC X,XPP(V)↔FMPR X,MAG↔FADR X,SOX↔XDC. X,V↔HLLES X
LAC Y,YPP(V)↔FMPR Y,MAG↔FADR Y,SOY↔YDC. Y,V↔HLLES Y
;DO XY-CLIP MARKING.
TYPE 0,V↔TRZ(NSEW);NSEW RESET.
CAMLE Y,YH↔TRO(NORTH)
CAMGE Y,YL↔TRO(SOUTH)
CAMLE X,XH↔TRO(EAST)
CAMGE X,XL↔TRO(WEST)
TYPE. 0,V↔POP0J
ENDR;2/5/73(BGB)-----------------------------------------------------
SUBR(EXTARW,NODE,CAMERA)
ACCUMULATORS{N,T1,T2,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3}
LAC N,NODE
TESTZ N,TBIT1↔POP2J
LDB 0,[POINT 3,(N),12] ;Get type of extension
CAILE 0,3 ;If less than 3 then get face coefficients
GO NOFACE
TRNN 0,1 ;Is PFACE involved?
GO NOTPFA
YPF 0,N ;Face coefficients for PFACE
CALL(FACOEF,0,[0])
LAC N,NODE
LDB 0,[POINT 3,(N),12] ;Get type of extension
TRNN 0,2 ;Is NFACE involved?
GO NOFACE
NOTPFA: YNF 0,N ;Face coefficients for NFACE
CALL(FACOEF,0,[0])
LAC N,NODE
NOFACE: PVT T1,N ;Pointer to first vertex in T1
PARRW 1,N↔PVT T2,1 ;Pointer to second vertex - T2
MARK N,TBIT1
MARK 1,TBIT1
FOR @` I ε {XYZ} ;Fetch second vertex coordinates.
< LAC I`1,I`WC(T2)
> ; -→
FOR @` I ε {XYZ} ;Subtract the first to get E1
< FSBR I`1,I`WC(T1)
>
LDB T1,[POINT 3,(N),12] ;Get type of extension
XCT [ ;Fetch appropriate face
GO [ ILGEXT: FATAL(ILLEGAL EXTENSION TYPE) ]
YPF T2,N
YNF T2,N
YPF T2,N
LACI T2,[1.0↔ 0 ↔ 0 ]+3
LACI T2,[ 0 ↔1.0↔ 0 ]+3
LACI T2,[ 0 ↔ 0 ↔1.0]+3
GO ILGEXT ](T1) ; -→
LAC X2,AA(T2) ;Copy normal into E2
LAC Y2,BB(T2)
LAC Z2,CC(T2)
CAIE T1,3 ;Is type 3?
GO L2 ;No
YNF T2,N ;Yes, make bisector of dihedral angle
CAMN X2,AA(T2) ;Zero check!
GO [ CAMN Y2,BB(T2)
CAME Z2,CC(T2)
GO .+1
GO L2 ]
FSBR X2,AA(T2)
FSBR Y2,BB(T2)
FSBR Z2,CC(T2) ; -→ -→ -→ -→ -→
L2: DEFINE CROSS `(X,Y,Z) ;The extension, E3 = E1 x NF (NF is in E2)
< LAC X`3,Y`1
LAC T1,Z`1
FMPR X`3,Z`2
FMPR T1,Y`2
FSBR X`3,T1
>
CROSS X,Y,Z
CROSS Y,Z,X
CROSS Z,X,Y
;---- EXTARW continued.
CALL EXTONE ;Calculate world co-ordinates for each
PARRW N,N
CALL EXTONE
CALL APROJ,N,CAMERA ;Run each thru projector
CALL MAKDPY
PARRW N,N
CALL APROJ,N,CAMERA
CALL MAKDPY
POP2J
;EXTEND ONE VERTEX
EXTONE: PVT T1,N
FOR @` I ε {XYZ} ; -→
< LAC I`1,I`3 ;Copy E3
FADR I`1,I`WC(T1) ;Add to V1
DAC I`1,I`PP(N) ;Store into V1' (into incorrect place!)
>
POP0J
;COMPUTE DISPLAY COORDINATES OF THE VERTEX.
MAKDPY: PVT T1,N ;Fetch vertex
FOR @` I ε {XYZ}
< LAC I`1,I`PP(N)↔FSBR I`1,I`PP(T1)
>
LAC 0,X1↔FMPR 0,0↔LAC 1,Y1↔FMPR 1,1↔FADR 0,1
CALL SQRT,0↔LAC 0,OFFSET(N)↔FDVR 0,1
FOR @` I ε {XYZ}
< FMPR I`1,0↔FADR I`1,I`PP(T1)↔DAC I`1,I`PP(N)
>
LAC 0,XPP(N)↔FMPR 0,MAG↔FADR 0,SOX↔XDC. 0,N
LAC 0,YPP(N)↔FMPR 0,MAG↔FADR 0,SOY↔YDC. 0,N
POP0J
;Arrow Extension Mandala
COMMENT $
The dimensioning in GEOMED is done semi-automatically, by the the
command αA. It positions the arrow in terms of the offset from the
two points and a face which determines the direction of the
extension lines. This direction is calculated as follows.
V1' V2'
⊗-----------------------⊗
| |
|-→ |
|E2 -→ |
| E1 |
V1⊗-----------------------⊗V2
| __ \
| -→ /| \
| NF / \
| F1 / \
| / \
| ⊗ \
| \
⊗-------------------------------⊗
The face, F1 is defined as Ax+By+Cz+K=0
-→
The normal to F1 is: NF = (A,B,C)
-→
The endpoint of the extension, V1' is to be perpendicular to edge E1
defined by the two points, V1 and V2, and parallel to the face F1.
V1' may be defined as
-→ -→ -→ -→
V1' = V1 + k E2 where E2 = E1 X NF
-→
and similarly V2' = V2 + k E2.
The constant, k, is chosen automatically according to the distance
from the camera and focal length.
$;
ENDR EXTARW;6-JUN-D73(TVR)
END
VIEWER - EOF.